home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / dow.exe / DOWTST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-04-13  |  1.7 KB  |  54 lines
  1. program DowTst;                     {Turbo Pascal 5.0, 5.5, 6.0}
  2.  
  3. { Ref: Determining Day Of Week, PC Magazine, April 28, 1992, p428 }
  4.  
  5. {-------}
  6. { Dow returns day of week as an integer (0 = Sunday, 1 = Monday, ..
  7.   6 = Saturday).  The inputs are not checked for validity.
  8.   Example: Dow(1,31,1992) returns 5.}
  9.  
  10. function Dow(Month,Day,Year : integer) : integer;
  11.  
  12. const
  13.   Calendar : array[0..11] of integer = (0,1,-1,0,0,1,1,2,3,3,4,4);
  14. begin
  15.   Dow :=  (((Year-1)*longint(365))   {num of days of normal years - 1}
  16.            + ((Year-1) div 4)        {num of possible leap days}
  17.            - (((Year-1) div 100)     {num of non-century leap days}
  18.            - ((Year-1) div 400))
  19.                                      {num of days in month passed}
  20.            + (Calendar[Month-1] + ((Month-1)*30))
  21.            + integer((((Year mod 4 = 0) and (Year mod 100 <> 0))
  22.                                 or (Year mod 400 = 0)) and (Month > 2))
  23.            + Day) mod 7
  24. end; {Dow}
  25. {-------}
  26. { DowStr returns day of week as a string (Sun, Mon, Tue, Wed, Thu, Fri, Sat).
  27.   Example: DowStr(1,31,1992) returns 'Fri'). }
  28.  
  29. function DowStr(Month,Day,Year : integer) : string;
  30.  
  31. const
  32.   DayS : array[0..6] of string[3]=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  33. begin
  34.   DowStr := DayS[Dow(Month,Day,Year)]
  35. end; {DowStr}
  36. {-------}
  37.  
  38. var
  39.   Month,Day,Year,Code : integer;
  40.  
  41. begin
  42.   if ParamCount <> 3 then
  43.     begin
  44.       Write('Enter date (MM DD YYYY): ');
  45.       Read(Month,Day,Year);
  46.     end
  47.   else
  48.     begin
  49.       Val(ParamStr(1),Month,Code);
  50.       Val(ParamStr(2),Day,Code);
  51.       Val(Paramstr(3),Year,Code)
  52.     end;
  53.   Writeln('Day of week: ',DowStr(Month,Day,Year));
  54. end.